unit uSerialHelper;

interface

uses
  Rtti, JSON, TypInfo;

type
  NoSerialization = class(TCustomAttribute);

  TSerialHelper = class helper for TObject
  private
    function isPublicProperty(aProperty: TRttiProperty): boolean;
    function isSerialProperty(aProperty: TRttiProperty): boolean;
    procedure setValue(aObject: IJSONObject; aValue: TValue; const aKey: string);
    // function serializeArray(aArray : TValue) : TJSONArray;
    // function deserializeArray(aArray : TJSONArray; aProperty : TRttiProperty) : TArray<TValue>;
  public
    function serialize: string;
    procedure deserialize(const aText: string);
  end;

implementation

{ TSerialHelper }

procedure TSerialHelper.deserialize(const aText: string);
var
  context: TRttiContext;
  typ: TRttiType;
  prop: TRttiProperty;
  jo: IJSONObject;
begin
  jo := TJSON.NewObject(aText);
  typ := context.GetType(self.ClassType);
  for prop in typ.GetProperties do
  begin
    if isSerialProperty(prop) and jo.HasKey(prop.Name) then
    begin
      case prop.PropertyType.TypeKind of
        tkInteger, tkInt64:
          prop.setValue(self, TValue.From<Int64>(jo.GetInteger(prop.Name)));
        tkEnumeration:
          if prop.GetValue(self).IsType<boolean> then
            prop.setValue(self, TValue.From<boolean>(jo.getBoolean(prop.Name)));
        tkFloat:
          prop.setValue(self, TValue.From<double>(jo.getDouble(prop.Name)));
        tkChar, tkString, tkWChar, tkLString, tkWString, tkUString:
          prop.setValue(self, TValue.From<string>(jo.getString(prop.Name)));
      end;
    end;
  end;
end;

function TSerialHelper.isPublicProperty(aProperty: TRttiProperty): boolean;
begin
  result := aProperty.Visibility in [mvPublic, mvPublished];
end;

function TSerialHelper.isSerialProperty(aProperty: TRttiProperty): boolean;
var
  a: TCustomAttribute;
begin
  result := true;
  for a in aProperty.GetAttributes do
  begin
    result := result and not(a is NoSerialization);
  end;
  result := result and isPublicProperty(aProperty) and aProperty.IsWritable and (aProperty.Name <> 'ComObject');
end;

function TSerialHelper.serialize: string;
var
  context: TRttiContext;
  typ: TRttiType;
  prop: TRttiProperty;
  jo: IJSONObject;
  value: TValue;
begin
  typ := context.GetType(self.ClassType);
  jo := TJSON.NewObject;
  for prop in typ.GetProperties do
  begin
    if isSerialProperty(prop) then
    begin
      value := prop.GetValue(self);
      setValue(jo, value, prop.Name);
    end;
  end;
  result := jo.toString(true);
end;

procedure TSerialHelper.setValue(aObject: IJSONObject; aValue: TValue; const aKey: string);
begin
  case aValue.Kind of
    tkInteger, tkInt64:
      aObject.put(aKey, aValue.AsInteger);
    tkEnumeration:
      if aValue.IsType<boolean> then
        aObject.put(aKey, aValue.AsBoolean);
    tkFloat:
      aObject.put(aKey, aValue.AsExtended);
    tkChar, tkString, tkWChar, tkLString, tkWString, tkUString:
      aObject.put(aKey, aValue.AsString);
  end;
end;

end.
